home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / graphics / move4 / move.frm < prev    next >
Text File  |  1995-10-22  |  12KB  |  365 lines
  1. VERSION 4.00
  2. Begin VB.Form WinStyles 
  3.    Appearance      =   0  'Flat
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Windows Style Manipulations"
  6.    ClientHeight    =   6630
  7.    ClientLeft      =   1005
  8.    ClientTop       =   1545
  9.    ClientWidth     =   7365
  10.    BeginProperty Font 
  11.       name            =   "MS Sans Serif"
  12.       charset         =   1
  13.       weight          =   700
  14.       size            =   8.25
  15.       underline       =   0   'False
  16.       italic          =   0   'False
  17.       strikethrough   =   0   'False
  18.    EndProperty
  19.    ForeColor       =   &H80000008&
  20.    Height          =   7035
  21.    Icon            =   "MOVE.frx":0000
  22.    Left            =   945
  23.    LinkTopic       =   "Form1"
  24.    ScaleHeight     =   6630
  25.    ScaleWidth      =   7365
  26.    Top             =   1200
  27.    Width           =   7485
  28.    Begin VB.PictureBox Picture3 
  29.       Appearance      =   0  'Flat
  30.       BackColor       =   &H0000FFFF&
  31.       ForeColor       =   &H80000008&
  32.       Height          =   855
  33.       Left            =   480
  34.       ScaleHeight     =   825
  35.       ScaleWidth      =   2805
  36.       TabIndex        =   6
  37.       Top             =   5580
  38.       Width           =   2835
  39.    End
  40.    Begin VB.PictureBox Picture2 
  41.       Appearance      =   0  'Flat
  42.       AutoRedraw      =   -1  'True
  43.       BackColor       =   &H80000005&
  44.       ForeColor       =   &H80000008&
  45.       Height          =   855
  46.       Left            =   3960
  47.       ScaleHeight     =   825
  48.       ScaleWidth      =   2865
  49.       TabIndex        =   5
  50.       Top             =   5580
  51.       Width           =   2895
  52.    End
  53.    Begin VB.TextBox Text2 
  54.       Appearance      =   0  'Flat
  55.       Height          =   975
  56.       Left            =   3960
  57.       TabIndex        =   4
  58.       Text            =   "Text2"
  59.       Top             =   4500
  60.       Width           =   2895
  61.    End
  62.    Begin VB.CommandButton Command1 
  63.       Appearance      =   0  'Flat
  64.       BackColor       =   &H80000005&
  65.       Caption         =   "Push me !"
  66.       Height          =   975
  67.       Left            =   480
  68.       TabIndex        =   3
  69.       Top             =   4500
  70.       Width           =   2835
  71.    End
  72.    Begin VB.TextBox Text1 
  73.       Appearance      =   0  'Flat
  74.       Height          =   975
  75.       Left            =   480
  76.       TabIndex        =   2
  77.       Text            =   "Text1"
  78.       Top             =   3300
  79.       Width           =   6375
  80.    End
  81.    Begin VB.ListBox List1 
  82.       Appearance      =   0  'Flat
  83.       Height          =   2760
  84.       Left            =   3960
  85.       TabIndex        =   1
  86.       Top             =   360
  87.       Width           =   2895
  88.    End
  89.    Begin VB.PictureBox Picture1 
  90.       Appearance      =   0  'Flat
  91.       AutoRedraw      =   -1  'True
  92.       BackColor       =   &H80000005&
  93.       BeginProperty Font 
  94.          name            =   "MS Sans Serif"
  95.          charset         =   1
  96.          weight          =   400
  97.          size            =   8.25
  98.          underline       =   0   'False
  99.          italic          =   0   'False
  100.          strikethrough   =   0   'False
  101.       EndProperty
  102.       ForeColor       =   &H000000FF&
  103.       Height          =   2775
  104.       Left            =   480
  105.       Picture         =   "MOVE.frx":030A
  106.       ScaleHeight     =   2745
  107.       ScaleWidth      =   2865
  108.       TabIndex        =   0
  109.       Top             =   360
  110.       Width           =   2895
  111.    End
  112. End
  113. Attribute VB_Name = "WinStyles"
  114. Attribute VB_Creatable = False
  115. Attribute VB_Exposed = False
  116.  
  117. ' * You nneed the MOVE.BAS as well ! *
  118.  
  119. Option Explicit
  120.  
  121. Dim retInt%, retLng&
  122.  
  123. Dim oldX%, oldY%
  124.  
  125. Private Sub Command1_Click()
  126.  
  127.     MsgBox "If you hold down Ctrl you can even move me !", 64, "Notice"
  128.  
  129. End Sub
  130.  
  131. Private Sub Command1_DragOver(Source As Control, X As Single, Y As Single, State As Integer)
  132.  
  133. ' --> from VB3 used the Mouse_Move event !
  134.  
  135.  
  136.     ' this pice of code enables ANY concerned control to be moved freely --> even an entire form !
  137.     ReleaseCapture
  138.     retInt = SendMessage(Command1.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0&)
  139.  
  140. End Sub
  141.  
  142. Private Sub Command1_KeyDown(KeyCode As Integer, Shift As Integer)
  143.  
  144.     ' can be move when Ctrl in pressed !
  145.     If Shift = 2 Then Command1.DragMode = 1
  146.  
  147. End Sub
  148.  
  149. Private Sub Command1_KeyUp(KeyCode As Integer, Shift As Integer)
  150.  
  151.     Command1.DragMode = 0
  152.  
  153. End Sub
  154.  
  155. Private Sub Form_Load()
  156.  
  157.     SetControls
  158.  
  159.     Show
  160.  
  161.     ' after the form built we can insert a text now...
  162.     SetTexts
  163.     ' (BUT: it it will only be shown until... (!?) - Well!
  164.     
  165. End Sub
  166.  
  167. Private Sub List1_Click()
  168.  
  169.     List1.Clear
  170.  
  171.     For retInt = 1 To 20
  172.         List1.AddItem "Item #" & retInt
  173.     Next retInt
  174.  
  175. End Sub
  176.  
  177. Private Sub List1_GotFocus()
  178.  
  179.     ShowFocus List1
  180.  
  181. End Sub
  182.  
  183. Private Sub List1_LostFocus()
  184.  
  185.     ShowFocus List1
  186.  
  187. End Sub
  188.  
  189. Private Sub Picture1_GotFocus()
  190.  
  191.     ShowFocus Picture1
  192.  
  193. End Sub
  194.  
  195. Private Sub Picture1_LostFocus()
  196.  
  197.     ShowFocus Picture1
  198.  
  199. End Sub
  200.  
  201. Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  202.     
  203.     ' this should only be possible for the LEFT mouse key as usual.
  204.     If Button <> 1 Then Exit Sub
  205.  
  206.     ' this pice of code enables ANY concerned control to be moved freely --> even an entire form !
  207.     ReleaseCapture
  208.     retInt = SendMessage(Picture2.hWnd, WM_SYSCOMMAND, MOUSE_MOVE, 0&)
  209.  
  210. End Sub
  211.  
  212. Private Sub Picture3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  213.  
  214. If Button <> 1 Then Exit Sub
  215.  
  216. Picture3.ZOrder
  217.  
  218.     oldX = X
  219.     oldY = Y
  220.  
  221. End Sub
  222.  
  223. Private Sub Picture3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  224.  
  225. If Button <> 1 Then Exit Sub
  226.  
  227.     Picture3.Left = Picture3.Left + X - oldX
  228.     Picture3.TOP = Picture3.TOP + Y - oldY
  229.  
  230. End Sub
  231.  
  232. '                                                       '
  233. ' Here, all the setting are done.                       '
  234. ' *** WARNING ***                                       '
  235. ' This code was just put together for a demonstration.  '
  236. ' (YES, it was tested. THIS code is OK.)                '
  237. ' Please be careful with YOUR experiments !!!           '
  238. ' Noone will be responsible for your "results" !        '
  239. ' BUT: good results should be given to the public !     '
  240. '                                                       '
  241. Private Sub SetControls()
  242.  
  243.     Dim Style&
  244.  
  245.     Style = GetWindowLong(Picture1.hWnd, GWL_STYLE)             ' Obtain the actual style
  246.     Style = Style Or WS_THICKFRAME                              ' Give it a Sizable Frame
  247.     Style = Style Or WS_CAPTION                                 ' Give it a Caption
  248.     Style = Style Or WS_MINIMIZEBOX                             ' Give it a MinimizeBox
  249.     Style = Style Or WS_SYSMENU                                 ' Give it a System Menu
  250.     Style = SetWindowLong(Picture1.hWnd, GWL_STYLE, Style)      ' - pass the new style
  251.     Picture1.Height = Picture1.Height                           ' ! REBUILD THE CONTROL !
  252.     retInt = SetWindowText(Picture1.hWnd, "The Picture Box")    ' Give it a Name, too
  253.     Picture1.Height = Picture1.Height + 30                      ' ! REBUILD THE CONTROL !
  254.     Picture1.Height = Picture1.Height - 30                      ' the "extra kick" for VB4
  255.     
  256.     Picture1.CurrentY = 700
  257.     Picture1.ForeColor = &HFF0000  ' [blue]
  258.     Picture1.Print " This is a demonstration."
  259.     Picture1.ForeColor = &H0&      ' [black]
  260.     Picture1.Print " Please";
  261.     Picture1.ForeColor = &HFF&     ' [red]
  262.     Picture1.Print " do not add";
  263.     Picture1.ForeColor = &H0&      ' [black]
  264.     Picture1.Print " system menus"
  265.     Picture1.Print " to controls like this here !"
  266.     
  267.     Style = GetWindowLong(List1.hWnd, GWL_STYLE)                ' Obtain the actual style
  268.     Style = Style Or WS_THICKFRAME                              ' Give it a Dizable Frame
  269.     Style = Style Or WS_CAPTION                                 ' Give it a Caption
  270.     Style = Style Xor WS_MAXIMIZEBOX                            ' Remove the MaximizeBox
  271.     Style = SetWindowLong(List1.hWnd, GWL_STYLE, Style)         ' - pass the new style
  272.     retInt = SetWindowText(List1.hWnd, "The List Box")          ' Give it a Name
  273.     List1.Height = List1.Height + 30                            ' ! REBUILD THE CONTROL !
  274.     List1.Height = List1.Height - 30                            ' the "extra kick" for VB4
  275.     
  276.     List1.AddItem "Its nice and easy"
  277.     List1.AddItem "to manipulate controls"
  278.     List1.AddItem "this way !!!"
  279.     List1.AddItem "Come on, try it yourself !"
  280.     
  281.     Style = GetWindowLong(Text1.hWnd, GWL_STYLE)                ' Obtain the actual style
  282.     Style = Style Or WS_BORDER                                  ' Give it a Thin Frame (--> you may leave this out)
  283.     Style = Style Or WS_CAPTION                                 ' Give it a Caption
  284.     Style = Style Xor WS_MAXIMIZEBOX                            ' Remove the MaximizeBox
  285.     Style = SetWindowLong(Text1.hWnd, GWL_STYLE, Style)         ' - pass the new style
  286.     retInt = SetWindowText(Text1.hWnd, "The Text Box 1")          ' Give it a Name
  287.     ' same as: Text1 = "The Text Box"
  288.     ' NOTE: you can alter the text later.
  289.     Text1.Height = Text1.Height + 30                            ' ! REBUILD THE CONTROL !
  290.     Text1.Height = Text1.Height - 30                            ' ! REBUILD THE CONTROL !
  291.     
  292.     Style = GetWindowLong(Command1.hWnd, GWL_STYLE)             ' Obtain the actual style
  293.     Style = Style Or WS_BORDER                                  ' Give it a border (--> don't leave this out)
  294.     Style = Style Or WS_THICKFRAME                              ' Give it a sizable frame
  295.     Style = SetWindowLong(Command1.hWnd, GWL_STYLE, Style)      ' - pass the new style
  296.     Command1.Height = Command1.Height                           ' ! REBUILD THE CONTROL !
  297.  
  298.     Style = GetWindowLong(Text2.hWnd, GWL_STYLE)                ' Obtain the actual style
  299.     Style = Style Or WS_CAPTION                                 ' Give it a Caption
  300.     Style = Style Xor WS_MAXIMIZEBOX                            ' Remove the Maximizebox
  301.     Style = SetWindowLong(Text2.hWnd, GWL_STYLE, Style)         ' - pass the new style
  302.     Style = GetWindowLong(Text2.hWnd, GWL_EXSTYLE)              ' Obtain the actual extended style
  303.     Style = Style Or WS_EX_DLGMODALFRAME                        ' Give it a Thick Border
  304.     Style = SetWindowLong(Text2.hWnd, GWL_EXSTYLE, Style)       ' - pass the new extended style
  305.     retInt = SetWindowText(Text2.hWnd, "The Text Box 2")
  306.     ' same as: Text2 = "The Text Box"
  307.     Text2.Height = Text2.Height + 30                            ' ! REBUILD THE CONTROL !
  308.     Text2.Height = Text2.Height - 30                            ' the "extra kick" for VB4
  309.  
  310.     Picture2.CurrentX = 270
  311.     Picture2.CurrentY = 180
  312.     Picture2.Print "Step on me and move me !"
  313.     
  314.     Dim Text$
  315.     Text = "(Don't be shy)"                                     ' center the text correctly
  316.     Picture2.CurrentX = (Picture2.ScaleWidth - Picture2.TextWidth(Text)) / 2
  317.     Picture2.ForeColor = &HFF0008   ' [= blue]
  318.     Picture2.Print Text
  319.  
  320. End Sub
  321.  
  322. Private Sub SetTexts()
  323.  
  324.     Text1 = "Hi, I have no sizable border but a caption."
  325.  
  326.     Text2 = "I have a fixed double border..."
  327.  
  328. End Sub
  329.  
  330. '                                                       '
  331. ' Well, we have to help VB a little...                  '
  332. '                                                       '
  333. Private Sub ShowFocus(Control As Control)
  334.     
  335.     ' switches the active view of the caption on (and off !)
  336.     ' note: this a toggle function ; retInt receives the old value
  337.     retInt = FlashWindow(Control.hWnd, True)
  338.  
  339. End Sub
  340.  
  341. Private Sub Text1_GotFocus()
  342.  
  343.     ShowFocus Text1
  344.  
  345. End Sub
  346.  
  347. Private Sub Text1_LostFocus()
  348.  
  349.     ShowFocus Text1
  350.  
  351. End Sub
  352.  
  353. Private Sub Text2_GotFocus()
  354.  
  355.     ShowFocus Text2
  356.  
  357. End Sub
  358.  
  359. Private Sub Text2_LostFocus()
  360.  
  361.     ShowFocus Text2
  362.  
  363. End Sub
  364.  
  365.